home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / tclx7.5a- / tclx7 / usr / local / tclX / 7.5a-a2 / loadouster.tcl < prev    next >
Encoding:
Text File  |  1995-11-14  |  1.8 KB  |  53 lines
  1. #
  2. # loadouster.tcl --
  3. #
  4. # Procedure to load a Ousterhout index when its encountered.
  5. #------------------------------------------------------------------------------
  6. # Copyright 1992-1995 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: loadouster.tcl,v 5.0 1995/07/25 06:00:21 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. proc auto_load_ouster_index fn {
  20.     global auto_index
  21.     set dir [file dirname $fn]
  22.  
  23.     if [catch {set f [open $dir/tclIndex]}] {
  24.         return
  25.     }
  26.     set error [catch {
  27.         set id [gets $f]
  28.         if {$id == "# Tcl autoload index file, version 2.0"} {
  29.             eval [read $f]
  30.         } elseif {$id == "# Tcl autoload index file: each line identifies a Tcl"} {
  31.             while {[gets $f line] >= 0} {
  32.                 if {([string index $line 0] == "#")
  33.                         || ([llength $line] != 2)} {
  34.                     continue
  35.                 }
  36.                 set name [lindex $line 0]
  37.                 if {![info exists auto_index($name)]} {
  38.                     set auto_index($name) "source $dir/[lindex $line 1]"
  39.                 }
  40.             }
  41.         } else {
  42.             error "$dir/tclIndex isn't a proper Tcl index file"
  43.         }
  44.     } msg]
  45.     if {$f != ""} {
  46.         close $f
  47.     }
  48.     if $error {
  49.         global errorInfo errorCode
  50.         error $msg $errorInfo $errorCode
  51.     }
  52. }
  53.